home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue62 / Alfresco / AAHpWin.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-03  |  1.9 KB  |  82 lines
  1. {*********************************************************}
  2. {* AAHpWin                                               *}
  3. {* Copyright (c) Julian M Bucknall 2000                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Algorithms Alfresco: Heap manager using Windows heaps *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAHpWin;
  14.  
  15. {WARNING: this unit *must* appear first in your project's uses list.}
  16.  
  17. interface
  18.  
  19. implementation
  20.  
  21. uses
  22.   Windows; // it's OK to use the Windows unit: it allocates no memory
  23.  
  24. var
  25.   OrigHeap : TMemoryManager;
  26.   OurHeap  : TMemoryManager;
  27.   HeapHandle : THandle;
  28.  
  29. function OurGetMem(Size : integer) : pointer;
  30. begin
  31.   Result := HeapAlloc(HeapHandle, 0, Size);
  32. end;
  33.  
  34. function OurFreeMem(P : pointer) : integer;
  35. begin
  36.   if HeapFree(HeapHandle, 0, P) then
  37.     Result := 0
  38.   else
  39.     Result := 1;
  40. end;
  41.  
  42. function OurReallocMem(P : pointer; Size : integer) : pointer;
  43. begin
  44.   Result := HeapRealloc(HeapHandle, 0, P, Size);
  45. end;
  46.  
  47. procedure InitializeUnit;
  48. begin
  49.   {get the original manager}
  50.   GetMemoryManager(OrigHeap);
  51.  
  52.   {set up our heap manager}
  53.   OurHeap.GetMem := OurGetMem;
  54.   OurHeap.FreeMem := OurFreeMem;
  55.   OurHeap.ReallocMem := OurReallocMem;
  56.  
  57.   {create a Windows heap}
  58.   HeapHandle := HeapCreate(0, 1024*1024, 0);
  59.  
  60.   {replace heap manager with ours}
  61.   if (longint(HeapHandle) <> 0) then
  62.     SetMemoryManager(OurHeap);
  63. end;
  64.  
  65. procedure FinalizeUnit;
  66. begin
  67.   {restore the original manager}
  68.   SetMemoryManager(OrigHeap);
  69.  
  70.   {dispose of the Win32 heap}
  71.   if (longint(HeapHandle) <> 0) then
  72.     HeapDestroy(HeapHandle);
  73. end;
  74.  
  75. initialization
  76.   InitializeUnit;
  77.  
  78. finalization
  79.   FinalizeUnit;
  80.  
  81. end.
  82.